ADD DATA SOURCES!!!!!!!!!!!!!!!
| mpg | cyl | disp | hp | drat | wt | qsec | vs | am | gear | carb | |
|---|---|---|---|---|---|---|---|---|---|---|---|
| Mazda RX4 | 21.0 | 6 | 160.0 | 110 | 3.90 | 2.620 | 16.46 | 0 | 1 | 4 | 4 |
| Mazda RX4 Wag | 21.0 | 6 | 160.0 | 110 | 3.90 | 2.875 | 17.02 | 0 | 1 | 4 | 4 |
| Datsun 710 | 22.8 | 4 | 108.0 | 93 | 3.85 | 2.320 | 18.61 | 1 | 1 | 4 | 1 |
| Hornet 4 Drive | 21.4 | 6 | 258.0 | 110 | 3.08 | 3.215 | 19.44 | 1 | 0 | 3 | 1 |
| Hornet Sportabout | 18.7 | 8 | 360.0 | 175 | 3.15 | 3.440 | 17.02 | 0 | 0 | 3 | 2 |
| Valiant | 18.1 | 6 | 225.0 | 105 | 2.76 | 3.460 | 20.22 | 1 | 0 | 3 | 1 |
| Duster 360 | 14.3 | 8 | 360.0 | 245 | 3.21 | 3.570 | 15.84 | 0 | 0 | 3 | 4 |
| Merc 240D | 24.4 | 4 | 146.7 | 62 | 3.69 | 3.190 | 20.00 | 1 | 0 | 4 | 2 |
| Merc 230 | 22.8 | 4 | 140.8 | 95 | 3.92 | 3.150 | 22.90 | 1 | 0 | 4 | 2 |
| Merc 280 | 19.2 | 6 | 167.6 | 123 | 3.92 | 3.440 | 18.30 | 1 | 0 | 4 | 4 |
| Merc 280C | 17.8 | 6 | 167.6 | 123 | 3.92 | 3.440 | 18.90 | 1 | 0 | 4 | 4 |
| Merc 450SE | 16.4 | 8 | 275.8 | 180 | 3.07 | 4.070 | 17.40 | 0 | 0 | 3 | 3 |
| Merc 450SL | 17.3 | 8 | 275.8 | 180 | 3.07 | 3.730 | 17.60 | 0 | 0 | 3 | 3 |
| Merc 450SLC | 15.2 | 8 | 275.8 | 180 | 3.07 | 3.780 | 18.00 | 0 | 0 | 3 | 3 |
| Cadillac Fleetwood | 10.4 | 8 | 472.0 | 205 | 2.93 | 5.250 | 17.98 | 0 | 0 | 3 | 4 |
| Lincoln Continental | 10.4 | 8 | 460.0 | 215 | 3.00 | 5.424 | 17.82 | 0 | 0 | 3 | 4 |
| Chrysler Imperial | 14.7 | 8 | 440.0 | 230 | 3.23 | 5.345 | 17.42 | 0 | 0 | 3 | 4 |
| Fiat 128 | 32.4 | 4 | 78.7 | 66 | 4.08 | 2.200 | 19.47 | 1 | 1 | 4 | 1 |
| Honda Civic | 30.4 | 4 | 75.7 | 52 | 4.93 | 1.615 | 18.52 | 1 | 1 | 4 | 2 |
| Toyota Corolla | 33.9 | 4 | 71.1 | 65 | 4.22 | 1.835 | 19.90 | 1 | 1 | 4 | 1 |
| Toyota Corona | 21.5 | 4 | 120.1 | 97 | 3.70 | 2.465 | 20.01 | 1 | 0 | 3 | 1 |
| Dodge Challenger | 15.5 | 8 | 318.0 | 150 | 2.76 | 3.520 | 16.87 | 0 | 0 | 3 | 2 |
| AMC Javelin | 15.2 | 8 | 304.0 | 150 | 3.15 | 3.435 | 17.30 | 0 | 0 | 3 | 2 |
| Camaro Z28 | 13.3 | 8 | 350.0 | 245 | 3.73 | 3.840 | 15.41 | 0 | 0 | 3 | 4 |
| Pontiac Firebird | 19.2 | 8 | 400.0 | 175 | 3.08 | 3.845 | 17.05 | 0 | 0 | 3 | 2 |
| Fiat X1-9 | 27.3 | 4 | 79.0 | 66 | 4.08 | 1.935 | 18.90 | 1 | 1 | 4 | 1 |
| Porsche 914-2 | 26.0 | 4 | 120.3 | 91 | 4.43 | 2.140 | 16.70 | 0 | 1 | 5 | 2 |
| Lotus Europa | 30.4 | 4 | 95.1 | 113 | 3.77 | 1.513 | 16.90 | 1 | 1 | 5 | 2 |
| Ford Pantera L | 15.8 | 8 | 351.0 | 264 | 4.22 | 3.170 | 14.50 | 0 | 1 | 5 | 4 |
| Ferrari Dino | 19.7 | 6 | 145.0 | 175 | 3.62 | 2.770 | 15.50 | 0 | 1 | 5 | 6 |
| Maserati Bora | 15.0 | 8 | 301.0 | 335 | 3.54 | 3.570 | 14.60 | 0 | 1 | 5 | 8 |
| Volvo 142E | 21.4 | 4 | 121.0 | 109 | 4.11 | 2.780 | 18.60 | 1 | 1 | 4 | 2 |
WTF are you doing here? The gtfsrouter package allows us to calculate all stations reachable within a specified time period from a nominated station (isochrones). We use the hull polygon as an indicator for the city area reachable. The time of interest is Monday from 07:20 – 08:00.
WTF are you doing here?
https://rstudio.github.io/leaflet/
Interactive panning/zooming
Compose maps using arbitrary combinations of map tiles, markers, polygons, lines, popups, and GeoJSON.
Create maps right from the R console or RStudio
Embed maps in knitr/R Markdown documents and Shiny apps
Easily render Spatial objects from the sp package, or data frames with latitude/longitude columns
Use map bounds and mouse events to drive Shiny logic
---
title: "Data Science Transport – Second Assignment – Group 12"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
source_code: embed
---
```{r setup, include=FALSE}
library(flexdashboard)
library(gtfsrouter)
library(tidyverse)
library(tidytransit)
library(sf)
library(tmap)
library(units)
library(RColorBrewer)
tmap_mode("view")
```
last time {data-icon="fa-hourglass-half"}
=====================================
ADD DATA SOURCES!!!!!!!!!!!!!!!
- test1
- test2
### Chart 0
```{r}
library(leaflet)
leaflet() %>%
addTiles() %>%
addMarkers(lng=174.768, lat=-36.852, popup="The birthplace of R")
```
### Chart 1
```{r}
# 1. Plot the dots themselves
```
### Cars
```{r}
knitr::kable(mtcars)
```
isochrones {data-icon="fa-expand-arrows-alt"}
=====================================
```{r, include = FALSE}
##############################################################
#
# READ GTFS DATA
#
##############################################################
# set work directions
setwd_gtfs <- function(){setwd("~/Documents/Uni/Master/DataScienceTransport/data/vbb-gtfs")}
setwd_data <- function(){setwd("~/Documents/Uni/Master/DataScienceTransport/data")}
setwd_work <- function(){setwd("~/Documents/Uni/Master/DataScienceTransport/assignment_2")}
setwd_work
# read gtfs data for monday
file <- file.path("~/Documents/Uni/Master/DataScienceTransport/data/vbb-gtfs/2020-12_2020-12-28.zip")
gtfs <- extract_gtfs(file) %>% gtfs_timetable(day = 2)
##############################################################
#
# SET TIMES
#
##############################################################
start_time <- 7 * 3600 + 1200
end_time <- 8 * 3600
# create isochrone
# ic <- gtfs_isochrone (gtfs,
# from = from,
# start_time = start_time,
# end_time = end_time)
##############################################################
#
# CREATE STOPS SF OBJECT
#
##############################################################
stops <- st_as_sf(gtfs$stops,
coords = c("stop_lon", "stop_lat"),
crs = 4326) %>%
st_transform(25833)
##############################################################
#
# SHAPE DISTRICTS NEW (+ area)
#
##############################################################
setwd_data()
shape_districts_new <- read_sf(dsn = "LOR_SHP_2019-1", layer = "Planungsraum_EPSG_25833")
setwd_work()
shape_districts_new <- shape_districts_new %>%
group_by(BEZIRK) %>%
summarise() %>%
filter(!is.na(BEZIRK)) %>%
rename(NAME = BEZIRK) %>%
mutate(AREA = st_area(geometry)) %>%
select(NAME, AREA, everything()) %>%
mutate(AREA = (AREA / 1000000) * as_units("km2"))
# setting crs of polygons
st_crs(shape_districts_new$geometry) <- 25833
shape_berlin <- st_union(shape_districts_new)
##############################################################
#
# SPECIFIC SHAPES AND STOPS
#
##############################################################
stops_in_berlin <- stops %>%
mutate(inside_berlin = st_within( geometry, shape_berlin )) %>%
mutate(inside_berlin = !is.na( as.numeric( inside_berlin ))) %>%
filter(inside_berlin == TRUE)
# get isochrone area
# ic = gtfs_isochrone (gtfs,
# from = "Berlin, Sowjetisches Ehrenmal",
# #from_is_id = TRUE,
# start_time = start_time,
# end_time = end_time)$hull$area
##############################################################
#
# CALCULATE ISOCHRONES
#
##############################################################
# # the following code calculates the isochrones
# # instead of running the code, we read in the pre-calculated file
# stops_ic_area <- vector(mode = "double")
#
# # create isochrone areas for stops in 50 minutes
# for (stop_name in stops$stop_name){
#
# tryCatch( {
# ic_area <- gtfs_isochrone (gtfs,
# from = stop_name,
# #from_is_id = TRUE,
# start_time = start_time,
# end_time = end_time)$hull$area
# if(is.null(ic_area)) {
# stops_ic_area <<- rbind(stops_ic_area, 0)
# print(paste(stop_name, ": ", ic_area, "!!!!!!!!!!"))
# } else {
# stops_ic_area <<- rbind(stops_ic_area, ic_area)
# print(paste(stop_name, ": ", ic_area))
# }
# },
# error = function(e) {
# stops_ic_area <<- rbind(stops_ic_area, 0)
# print(paste("ERROR!!!", stop_name))
# }
# )
# }
#
# ##############################################################
# #
# # CLEANING
# #
# ##############################################################
#
# # merge and clean
# # https://r-spatial.github.io/sf/reference/bind.html
# # https://cran.r-project.org/web/packages/units/vignettes/units.html
# rownames(stops_ic_area) <- NULL
# stops_area <- st_sf(data.frame(stops, stops_ic_area / 1000000)) %>%
# rename(ic_area = stops_ic_area.1e.06,
# id = stop_id,
# name = stop_name,
# parent = parent_station) %>%
# select(id, name, parent, ic_area) %>%
# mutate(ic_area = ic_area * as_units("km2"))
#
# # save
# # https://r-spatial.github.io/sf/reference/st_write.html
# st_write(stops_area, "output_stops_ic_area.shp")
stops_area <- st_read("output_stops_ic_area.shp")
# more cleaning for plot
# https://dplyr.tidyverse.org/reference/distinct.html
stops_area =
stops_area %>%
select(name, ic_area) %>%
distinct(name, .keep_all = TRUE)
stops_area_berlin <- stops_area %>%
mutate(inside_berlin = st_within( geometry, shape_berlin )) %>%
mutate(inside_berlin = !is.na( as.numeric( inside_berlin ))) %>%
filter(inside_berlin == TRUE) %>%
select(-inside_berlin) %>%
mutate(id = paste(name, ": ", round(ic_area)))
```
Column {data-width=100}
-------------------------------------
### About Isochrones
WTF are you doing here?
The [gtfsrouter](https://atfutures.github.io/gtfs-router/) package allows us to calculate all stations reachable within a specified time period from a nominated station ([isochrones](https://atfutures.github.io/gtfs-router/reference/gtfs_isochrone.html)). We use the hull polygon as an indicator for the city area reachable. The time of interest is Monday from 07:20 – 08:00.
### 30min IC home trip (18:00) from Helmholtzstr.
```{r}
ic_einstein <- gtfs_isochrone(gtfs,
from = "Berlin, Helmholtzstr.",
start_time = 18 * 3600,
end_time = 18 * 3600 + 1800)
tm_basemap(leaflet::providers$OpenStreetMap.DE) +
tm_shape(ic_einstein$hull) +
tm_polygons(col = "red",
alpha = 0.2,
border.col = "red",
id = NA) +
tm_shape(ic_einstein$routes) +
tm_lines(id = NA) +
tm_shape(ic_einstein$end_points) +
tm_dots(col = "red", id = NA) +
tm_shape(ic_einstein$start_point) +
tm_dots(col = "green")
```
### Chart 3
```{r}
tm_shape(shape_districts_new) +
tm_polygons(alpha = 0,
popup.vars = c("area" = "AREA")) +
tm_shape(stops_area_berlin) +
tm_dots(col = "ic_area",
id = "name",
popup.vars = c("area" = "ic_area"),
size = 0.07,
border.lwd = 0.3,
legend.hist = TRUE,
n = 15,
title = "isochrone area [km^2]") +
tm_view(bbox = shape_berlin)
```
Column {data-width=350}
-------------------------------------
### area size of the hull enclosing the routed points
```{r}
##############################################################
#
# PLOT
#
##############################################################
tm_shape(shape_districts_new) +
tm_polygons(alpha = 0,
popup.vars = c("area" = "AREA")) +
tm_shape(stops_area_berlin) +
tm_dots(col = "ic_area",
id = "name",
popup.vars = c("area" = "ic_area"),
size = 0.07,
border.lwd = 0.3,
legend.hist = TRUE,
n = 15,
title = "isochrone area [km^2]") +
tm_view(bbox = shape_berlin)
```
traveltimes to center {data-icon="fa-stopwatch"}
=====================================
```{r, include = FALSE}
##############################################################
#
# SHAPE CENTER AREAS
#
##############################################################
# "Zentrentragender Stadtraum mit höchster / hoher Urbanität"
# of Zentrumsbereichskernen
# see page 39: https://www.stadtentwicklung.berlin.de/planen/stadtentwicklungsplanung/download/zentren/2011-07-31_StEP_Zentren3.pdf
# or page 45 (less detailed): https://www.stadtentwicklung.berlin.de/planen/stadtentwicklungsplanung/download/zentren/StEP_Zentren_2030.pdf
# recreated with QGis
shape_center <- read_sf(dsn = "shape_center_areas", layer = "center_areas") %>%
mutate(name = c("east", "west")) %>%
select(name)
shape_center_east <- shape_center %>% filter(name == "east")
shape_center_west <- shape_center %>% filter(name == "west")
##############################################################
#
# READ GTFS DATA
#
##############################################################
# now we work with tidytransit
# calculation of shortest tt from all station to specific ones is more convinent
setwd_gtfs()
gtfs <- read_gtfs("2020-12_2020-12-28.zip")
setwd_work()
# http://tidytransit.r-transit.org/reference/filter_stop_times.html
stop_times_filtered <- filter_stop_times(gtfs, "2021-01-18", "06:00:00", "07:55:00")
##############################################################
#
# GET STOPS
#
##############################################################
stops <- st_as_sf(gtfs$stops, coords = c("stop_lon", "stop_lat"), crs = 4326) %>%
st_transform(25833) %>%
select(stop_name) %>%
rename(name = stop_name) %>%
distinct(name)
stops_berlin <- stops %>%
mutate(inside_berlin = st_within( geometry, shape_berlin )) %>%
mutate(inside_berlin = !is.na( as.numeric( inside_berlin ))) %>%
filter(inside_berlin == TRUE) %>%
select(name)
stops_center <- stops %>%
mutate(inside_center = st_within( geometry, shape_center )) %>%
mutate(inside_center = !is.na( as.numeric( inside_center ))) %>%
filter(inside_center == TRUE) %>%
select(name)
stops_center_east <- stops %>%
mutate(inside_center_east = st_within( geometry, shape_center_east )) %>%
mutate(inside_center_east = !is.na( as.numeric( inside_center_east ))) %>%
filter(inside_center_east == TRUE) %>%
select(name)
stops_center_west <- stops %>%
mutate(inside_center_west = st_within( geometry, shape_center_west )) %>%
mutate(inside_center_west = !is.na( as.numeric( inside_center_west ))) %>%
filter(inside_center_west == TRUE) %>%
select(name)
##############################################################
#
# TT calculation
#
##############################################################
# what are the tt to the center areas?
# according to Nahverkehrsplan Berlin 2019-2023: ANlage 1 - Monitoringbericht (p. 12)
# standard: tt_max = 3600, n_transfer_max = 2, n_realise_stations = 0.95
tt <- travel_times(
stop_times_filtered,
stops_center$name,
time_range = 5400,
arrival = TRUE,
max_transfers = 2,
# max_departure_time = NULL,
return_coords = TRUE,
return_DT = FALSE
)
# clean it for plot
tt <- tt %>%
rename(from = from_stop_name,
to = to_stop_name,
tt = travel_time,
departure = journey_departure_time,
arrival = journey_arrival_time
) %>%
select(-c(from_stop_id, to_stop_id, to_stop_lat, to_stop_lon)) %>%
st_as_sf(coords = c("from_stop_lon", "from_stop_lat"),
crs = 4326) %>%
st_transform(25833) %>%
mutate(tt = set_units(round(tt/60, 2), "min"))
```
Column {data-width=100}
-------------------------------------
### About
WTF are you doing here?
### Chart 1
```{r}
```
### Chart 3
```{r}
```
Column {data-width=300}
-------------------------------------
### Chart 2
```{r}
##############################################################
#
# PLOT
#
##############################################################
# https://campus.datacamp.com/courses/visualizing-geospatial-data-in-r/raster-data-and-color?ex=9
rdylgn <- rev(brewer.pal(7, "RdYlGn"))
# https://leaflet-extras.github.io/leaflet-providers/preview/
# https://tlorusso.github.io/geodata_workshop/tmap_package
# https://www.rdocumentation.org/packages/tmap/versions/3.0/topics/tm_basemap
# https://rdrr.io/cran/tmap/man/tm_view.html
# https://leafletjs.com/reference-1.3.4.html#map-methods-for-modifying-map-state
tm_basemap(leaflet::providers$CartoDB.DarkMatter) +
tm_shape(shape_districts_new) +
tm_polygons(alpha = 0,
lwd = 1.5,
border.col = "white") +
tm_shape(shape_center) +
tm_polygons(alpha = 0.2,
col = "red",
border.col = "red"
) +
tm_shape(tt) +
tm_dots(col = "tt",
style = "fixed",
breaks = c(0, 10, 20, 30, 40, 50, 60, 120),
labels = c("0 – 10", "10 – 20", "20 – 30", "30 – 40", "40 – 50", "50 – 60", "> 60"),
id = "from",
palette = rdylgn,
title = "traveltime [min]",
popup.vars=c("from" = "from",
"to" = "to",
"traveltime" = "tt",
"departure at" = "departure",
"arrival at" = "arrival",
"number of transfers" = "transfers")) +
tm_view(bbox = shape_center)
```
***
https://rstudio.github.io/leaflet/
- Interactive panning/zooming
- Compose maps using arbitrary combinations of map tiles, markers, polygons, lines, popups, and GeoJSON.
- Create maps right from the R console or RStudio
- Embed maps in knitr/R Markdown documents and Shiny apps
- Easily render Spatial objects from the sp package, or data frames with latitude/longitude columns
- Use map bounds and mouse events to drive Shiny logic